unit uUnrefObj;

interface

uses Windows;

const
  IID_IBaseObject: TGUID = '{DF11AC1F-3048-49AE-A8CB-73D0876FD1A0}';

type
  {* Base class for non-refcounted interfaced object *}

  IBaseObject = interface(IInterface)
  ['{DF11AC1F-3048-49AE-A8CB-73D0876FD1A0}']
    function GetPointer: pointer; stdcall;
    function FreeObject: HResult; stdcall;
  end;

  TUnrefInterfacedObject = class(TObject, IBaseObject)
  public
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    function GetPointer: pointer; stdcall;
    function FreeObject: HResult; stdcall;
  end;

function CoWStrAlloc(Size: Cardinal): PWideChar;
function WStrAlloc(Size: Cardinal): PWideChar;
procedure WStrDispose(Str: PWideChar);
function WStrLen(const Str: PWideChar): Cardinal;
function WStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;
function WStrLCopy(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;

function CoTaskAllocStr(src: PChar): PWideChar; overload;
function CoTaskAllocStr(src: PWideChar): PWideChar; overload;

function strPas(c: PChar): string; overload;
function strPas(c: PWideChar): widestring; overload;

implementation

uses ActiveX;

{* Some AX&WS stuff *}

function CoWStrAlloc(Size: Cardinal): PWideChar;
begin
  Size := Size * Sizeof(WideChar);
  Inc(Size, SizeOf(Cardinal));
  Result := CoTaskMemAlloc(Size);
  ZeroMemory(Result, size);
  Cardinal(Pointer(Result)^) := Size;
  Inc(PChar(Result), SizeOf(Cardinal));
end;

function WStrAlloc(Size: Cardinal): PWideChar;
begin
  Size := Size * Sizeof(WideChar);
  Inc(Size, SizeOf(Cardinal));
  GetMem(Result, Size);
  Cardinal(Pointer(Result)^) := Size;
  Inc(PChar(Result), SizeOf(Cardinal));
end;

procedure WStrDispose(Str: PWideChar);
begin
  if Str <> nil then begin
    Dec(PChar(Str), SizeOf(Cardinal));
    FreeMem(Str, Cardinal(Pointer(Str)^));
  end;
end;

function WStrLen(const Str: PWideChar): Cardinal;
var
  P : PWideChar;
begin
  P := Str;
  while (P^ <> #0) do Inc(P);
  Result := (P - Str);
end;

function WStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;
var
  Src : PWideChar;
begin
  Result := Dest;
  Src := Source;
  while (Src^ <> #$00) do begin
    Dest^ := Src^;
    Inc(Src);
    Inc(Dest);
  end;
  Dest^ := #$00;
end;

function WStrLCopy(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
var Src : PWideChar;
begin
  Result := Dest;
  Src := Source;
  while (Src^ <> #$00) and (MaxLen > 0) do begin
    Dest^ := Src^;
    Inc(Src);
    Inc(Dest);
    Dec(MaxLen);
  end;
  Dest^ := #$00;
end;

function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;
begin
  Result := WStrLCopy(Dest, PWideChar(Source), Length(Source));
end;

function StringToWideString(const s: AnsiString; codePage: Word): WideString;
var l: integer;
begin
  if s = '' then Result := ''
  else begin
    l := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PChar(@s[1]), -1, nil, 0);
    SetLength(Result, l - 1);
    if l > 1 then
      MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PChar(@s[1]),
        -1, PWideChar(@Result[1]), l - 1);
  end;
end; { StringToWideString }

function CoTaskAllocStr(src: PChar): PWideChar; overload;
var ws: string;
begin
  Result := CoWStrAlloc(length(strPas(src))+1);
  ws := StringToWideString(strPas(src), CP_ACP);
  WStrPCopy(Result, ws);
end;

function CoTaskAllocStr(src: PWideChar): PWideChar; overload;
begin
  Result := CoWStrAlloc(WStrLen(src)+1);
  WStrCopy(Result, src);
end;

function strPas(c: PChar): string;
begin
  if (c<>nil) then Result := string(c)
  else Result := '';
end;

function strPas(c: PWideChar): widestring;
begin
  if (c<>nil) then Result := widestring(c)
  else Result := '';
end;

{ TUnrefInterfacedObject }

function TUnrefInterfacedObject._AddRef: Integer;
begin
  Result := -1;
end;

function TUnrefInterfacedObject._Release: Integer;
begin
  Result := -1;
end;

function TUnrefInterfacedObject.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := 0
  else Result := E_NOINTERFACE;
end;

function TUnrefInterfacedObject.FreeObject: HResult;
begin
  Result := 0;
  Free;
end;

function TUnrefInterfacedObject.GetPointer: pointer;
begin
  Result := Self;
end;

initialization
  CoInitialize(nil);

finalization

end.